New Star Software Collection/NSS_Collection.iso/3-170 dbase 10 for windows/1.ima/SAMPLES.PAK/SAMPPROC.PRG

Text File | 1993-07-26 | 39KB | 1,187 lines

*******************************************************************************
*  PROGRAM:      Sampproc.prg
*
*  WRITTEN BY:   Borland Late Night Crew
*
*  DATE:         7/22/93
*
*  UPDATED:
*
*  VERSION:      Alpha α
*
*  DESCRIPTION:  This is the procedure file called by all Bladerunner samples.
*
*  PARAMETERS:   None
*
*  CALLS:
*
*  USAGE:        SET PROCEDURE TO Sampproc
*
*
*******************************************************************************


********************************** Classes ************************************

*** Class for Focus2.prg
*******************************************************************************
class MyWindow of Window()
*  Called by Focus2.prg
*******************************************************************************
   this.top =  100       && window pixel row
   this.width = 300      && window pixel width
   this.clickcount = 0   && variable indicating number of times the mouse
                         && was clicked in this window.  Incremented in the
                         && OnLeftMouseDown event handler function
   this.button = new Pushbutton(this)  && pushbutton of this, the window
   this.button.width = 100   && width of pushbutton
   this.button.caption = "Pushbutton"
   this.button.left = 85
   this.button.height = 40

   *******************************************************************************
   function OnGotFocus
   *  Sets this window's caption when this window has focus.
   *******************************************************************************
      this.caption = "I have focus"
      return .t.

   *******************************************************************************
   function OnLostFocus
   *  Changes the title of this window when another window obtains focus.
   *******************************************************************************
      this.caption = "I have focus NOT"
      return .t.

   *******************************************************************************
   function OnLeftMouseDown
   *  When the mouse is clicked inside this window, increments the count of
   *  clicks in the window, which basically amounts to the number of times
   *  the window has been in focus since the program was started.
   *******************************************************************************
       parameters x,y,flags
       this.clickcount = this.clickcount+1
       this.button.caption = ltrim(str(this.clickcount))
    return .t.


endclass

*** Classes for Puzzle.prg

*******************************************************************************
class MenuWindow of Window
*
* Called by Puzzle.prg
*******************************************************************************
    private Puzzle,Draw

    this.height = 150
    this.width = 240
    this.caption = "Create New Windows"

    Puzzle = new PushButton(this)
    Puzzle.Caption = "New Puzzle Window"
    Puzzle.enabled = .t.
    Puzzle.OnLeftMouseDown = MakePuzzle   && Create puzzle when left mouse
                                          && button is pressed
    Puzzle.top = 5
    Puzzle.Left = 5
    Puzzle.Width = 200

    Draw = new PushButton(this)
    Draw.Caption = "New Draw Window"      && Create the Ray painter when left
                                          && mouse button is pressed
    Draw.enabled = .t.
    Draw.OnLeftMouseDown = MakeDraw
    Draw.top = 30
    Draw.Left = 5
    Draw.Width = 200

    Paint = new PushButton(this)
    Paint.Caption = "New Paint Window"
    Paint.enabled = .t.
    Paint.OnLeftMouseDown = MakePaint     && Create the Line painter when left
                                          && mouse button is pressed
    Paint.top = 55
    Paint.Left = 5
    Paint.Width = 200


endclass



*******************************************************************************
class DrawWindow of window

* Defines the ray painting window.
*
* Called by Puzzle.prg
*******************************************************************************

    this.visible = .f.
    this.caption = "Press Mouse And Move"  && when you press the mouse, move
                                           && it, and let go, a series of rays
                                           && will appear with the origin at
                                           && the point where you pressed down
                                           && the mouse

    *-- set the initial size of the window
    this.height = 400
    this.width = 400
    this.visible = .t.
    this.xpos = 0
    this.ypos = 0
    this.hDc = 0
    this.pen = 0

    * Color pushbuttons
    this.red = new PushButton(this)
    this.red.Caption = "RED"
    this.red.enabled = .t.
    this.red.OnLeftMouseDown = PushedButton  && OnLeftMouseDown event handler
    this.red.top =  this.height - 80
    this.red.Left = 5
    this.red.Width = 50
    this.red.colorval = 255
    this.red.owner = this    && parent window

    this.blue = new PushButton(this)
    this.blue.Caption = "BLUE"
    this.blue.enabled = .t.
    this.blue.OnLeftMouseDown = PushedButton
    this.blue.top =  this.height - 80
    this.blue.Left = 60
    this.blue.Width = 50
    this.blue.colorval = 255
    this.blue.owner = this

    this.green = new PushButton(this)
    this.green.Caption = "GREEN"
    this.green.enabled = .t.
    this.green.OnLeftMouseDown = PushedButton
    this.green.top =  this.height - 80
    this.green.Left = 115
    this.green.Width = 50
    this.green.colorval = 255
    this.green.owner = this

    *************************************************
    function Init
    *  Initializes the window
    *************************************************
        junk = this.OnSize(0,0,0)
    junk = this.SetButtonColor()
    return .f.

    *************************************************
    function OnLeftMouseDown
    * When the left mouse button is pressed, move to
    * that point
    *************************************************
        parameters x, y, flags

        this.xpos = x
        this.ypos = y
        *this.capture = .t.
        this.hDc = GetDC( this.hWnd )
        this.pen = CreatePen(0,1,this.color)
        junk = SelectObject( this.hDc, this.pen )
        junk = MoveTo(this.hDc, this.xpos, this.ypos)
        return .t.

    *************************************************
    function OnLeftMouseUp
    * When the button is released, release the current
    * pen used
    *************************************************
        parameters x, y, flags
        private i

        *this.capture = .f.
        i = ReleaseDC(this.hWnd, this.hDc)
        this.hDc = 0
        i = DeleteObject(this.pen)
        this.pen = 0
        return .t.

    *************************************************
    function OnMouseMove

    * When the mouse is being moved, draw a line from
    * the point where the mouse button was pressed to
    * each point the mouse moves to.  This creates rays.
    *************************************************
        parameters x, y, flags
        private junk

        if this.hDc <> 0
            junk = MoveTo(this.hDc, this.xpos, this.ypos)
            junk = LineTo(this.hDc, x, y )
        endif
        return .t.

    *************************************************
    function OnSize
    *************************************************
        parameters top, left, width

        this.red.top = this.height - 80
        this.green.top = this.height - 80
        this.blue.top = this.height - 80
        return .f.

    *************************************************
    function SetButtonColor
    *  Sets the color of the current rays.
    *************************************************
        private dc,brush, r

        this.color = RGB(this.red.colorval, this.green.colorval, this.blue.colorval)
        dc = GetDC(this.hwnd)
        brush = CreateSolidBrush(this.color)
        r = Rect(this.green.left+this.green.width+5,this.height-80, 50, 50)
        * Fill a small rectangle with the current color
        junk = FillRect(dc,r,brush)
        junk = ReleaseDC(this.hwnd,dc)
        junk = DeleteObject(brush)
        return .f.

endclass


*******************************************************************************
class PaintWindow of DrawWindow
* Defines the Line painter window
*
* Called by Puzzle.prg
*******************************************************************************

    this.caption = "Draw Lines"

    *************************************************
    function OnMouseMove
    *  When the mouse is moved, draw a line from the
    *  last position using the current color.  This
    *  creates a continuous line as you move the mouse.
    *************************************************
        parameters x, y, flags
        private junk
        if this.hDc <> 0
            junk = LineTo(this.hDc, x, y )
        endif
        return .f.

endclass


*******************************************************************************
class Puzzle of window
* Creates a window with a 15 button puzzle
*
* Called by Puzzle.prg
*******************************************************************************
    private i, parent, junk

    this.visible = .f.
    this.caption = "Puzzle"

    *-- set the initial size of the window
    this.height = 400
    this.width = 400



    *-- set the current position of the hole
    this.holex = 4
    this.holey = 4

    parent = this

    *-- create 15 buttons inside the window.
    for i = 1 to 4
        for j = 1 to 4
            if(i*j <> 16)
                globx = i
                globy = j
                b = new ButtonTile()
            endif
        next
    next

    *************************************************
    function Show
    *************************************************
        private i
        i = this.OnSize(0,0,0)
        this.visible = .t.
        return .t.

    *************************************************
    function OnSize
    *  If the puzzle window is resized, resize the
    *  buttons too.
    *************************************************
        parameters top, left, width
        private h,w,b,i

        *-- BUG: account for menu width and scroll bars
        this.h=this.height-100
        this.w=this.width-50

        h = this.h/4
        w = this.w/4


        * redefine dimensions for the 15 buttons.
        for i = 1 to 15
            b = this[i]
            b.visible = .f.    && invisible so don't see flashing
            b.top = (b.y-1)*h
            b.left = (b.x-1)*w
            b.width = w
            b.height = h
            b.enabled = .t.
        next
        * make them all visible
        for i = 1 to 15
            this[i].visible = .t.
        next
        return .f.

    *************************************************
    function MoveButton
    *  When a button is moved, assign it a new location,
    *  and put a hole in its previous location.
    *************************************************
        parameter b
        private x,y, i, j, number,o

        if abs(this.holex-b.x) + abs(this.holey-b.y) = 1

            b.visible =.f.

            x = this.holex
            this.holex = b.x
            b.x = x

            y = this.holey
            this.holey = b.y
            b.y = y

            b.top = this.h/4 * (b.y-1)
            b.left = this.w/4 * (b.x-1)

            b.visible = .t.
            i = this.CheckWinner()   && check if all buttons in place
        endif
        return .f.

    *************************************************
    function CheckWinner
    *  If all the buttons are in place, change the
    *  caption of the window to "Winner".
    *************************************************
        private i

        *-- check the position of each button for the correct position
        for i = 1 to 15
            if this[i].index <> (this[i].x-1)*4+this[i].y-1
                return .f.
            endif
        next

        *-- Set the caption of all the buttons to winner
        for i = 1 to 15
            this[i].caption = "Winner"
        next
        return .t.

endclass



*** Classes for Event.prg

*-- BUG: should be able to pass parameter to subobject's constructor.  There
*       is an implied parameter 'parent' to button Tile that currently has to
*       be passed as a global.
*
*class ButtonTile(parent, globx, globy) of Button(parent)
*******************************************************************************
class ButtonTile of PushButton(parent)
* Creates a puzzle button.
*
* Called by Event.prg
*******************************************************************************

    this.index = (globx-1)*4+globy-1
    this.caption = str(this.index+1,2)
    this.puzzle = parent                && should be unnecessary
    this.x = globx
    this.y = globy

    *************************************************
    Function OnLeftMouseDown
    *  When the mouse is pressed, check if the button
    *  can be moved, and move it, if appropriate.
    *************************************************
        parameters x, y, flags

        *--BUG: code should read 'parent.MoveButton(this)'
        *
        b = this
        x = this.puzzle.MoveButton(b)
        return .f.
endclass

*** Procedures and Functions Called by Contact.prg ***


******************************************************************************
procedure Selectcomp

* On selection routine for the Comp304 window.  Brings up a regression
* graph if "pushgraph" was selected, a window with a browse object
* if "pushsummar" was selected, and otherwise closes the window.
*
* Called by Contact.prg
******************************************************************************
private active
active = activecontrol()   && what control was active when selection was made?
do case
   case active = "PUSHGRAPH"
      select summary
      set filter to compcode = company->compcode
      *** BUG in GRAPH FORM -- while/for clauses cause GPF
      graph form activity &&while compcode=company->compcode
      set filter to
      select company
   case active = "PUSHSUMMAR"
      isBrowseUp = .t.
      define window BrowseWind from 10,10 to 25,70 ;
         of application;
         title "BROWSE"
      define browse companyBrowse of BrowseWind from 0,0 to 16,62

      open window BrowseWind
      set focus to BrowseWind
   otherwise
    * Cleanup()
    ***BUG -- problems closing the window after closing databases
    * close window Comp304
endcase
return

******************************************************************************
function CloseBrowse
* OnClose function for BrowseWindow
******************************************************************************
isBrowseUp = .f.
return .t.

******************************************************************************
function Contact_Clean

* Close all databases, and select the previous workarea.
*
* Called by Event.prg
******************************************************************************
on error *               && just in case BrowseWind isn't open
close window BrowseWind
on error
use
use in contact
use in summary
release isBrowseUp
return .t.


*** End of procedures and functions called by Contact.prg ***


*** Procedures and Functions called by Event.prg ***


*******************************************************************************
function MakeButtonWindow

* Creates a window with a button that will move to new coordinates inside
* the window when the left mouse button is clicked.
*
* Called by Event.prg
*******************************************************************************
    private o
    o = MakeWindow("Click anywhere to move button")
                                           && Make the window with one button
    o.OnLeftMouseDown=ButtonLeftMouseDown  && Assign the function
                                           && ButtonLeftMouseDown to the event
                                           && OnLeftMouseDown.  This is a
                                           && function pointer assignment.
                                           && The event gets the address of the
                                           && function to be executed.
    o.typewin = "Click anywhere to move button"
    return o

*******************************************************************************
function MakeSizeWindow

* Creates a window with a button.  This window will get resized as you click
* the left mouse button and move.
*
* Called by Event.prg
*******************************************************************************
    private o
    o = MakeWindow("Click anywhere to resize window")   && create the window
    o.OnMouseMove=MouseMove    && OnMouseMove event handler function
    o.OnLeftMouseDown=LeftMouseDown   && OnLeftMouseDown event handler function
    o.typewin = "Click anywhere to resize window"
    return o

*******************************************************************************
Function MakeWindow

* Creates a window with one pushbutton
*
* Called by Event.prg
*******************************************************************************
    param captionStart
    private x,o,b

    set talk off
    w = "X"+str(c+1000,4)
    b = "B"+str(c+1000,4)
    * Create the window using DEFINE syntax
    define window &w from 1,1 to 50,50 title "Window" MDI sizeable
    define push &b of &w at 10,10 prompt "Button"
    acti window &w
    * get a handle to the defined window using the findwindow() function
    o = findwindow(w)
    o.ourname = w
    o.OnGotFocus=WinGotFocus   && functions handling OnGotFocus and OnLostFocus
    o.OnLostFocus=WinLostFocus && events

    o.orgWidth = o.Width
    o.orgHeight = o.Height
    o.WindowNum = c
    o.bc = 1
    o.capStart = captionStart
    c = c + 1
    x= o.OnGotFocus()  && The window has focus initially
    return o

*******************************************************************************
function WinGotFocus
* OnGotFocus event handler function for the window
*
* Called by Event.prg
*******************************************************************************
    private w
    this.caption = this.capStart + " -- Got Focus #" + str(this.WindowNum,1)
    w = this.ourname
   *acti window &w
    return .f.

*******************************************************************************
procedure WinLostFocus
* OnLostFocus event handler function for the window
*
* Called by Event.prg
*******************************************************************************
    this.caption = this.capStart + " -- Lost Focus #" + str(this.WindowNum,1)

*******************************************************************************
function MouseMoveShow
*
* Called by Event.prg
*******************************************************************************
    parameters x, y, flags
    @ 0,0
    ? x,y


*******************************************************************************
procedure ButtonLeftMouseDown
* OnLeftMouseDown event handler for the window created with MakeButtonWindow()
*
* Called by Event.prg
*******************************************************************************
    parameters x, y, flags
    private w,b,i,j,k

    if bits(flags,3)
        j = 0
        k = 0
        x = 0
        y = 0
        for i = 1 to this.bc
            if bits(flags,2)
                this[i].height = this[i].height * 2
                this[i].width = this[i].width * 2
            endif
            if j + this[i].height > this.height
                x = x + k
                j = 0
            endif
            this[i].left = x
            this[i].top = j
            j = j + this[i].height
            if this[i].width > k
                k = this[i].width
            endif
        next
    else
        if bits(flags,2)
            this.bc = this.bc + 1
            b = "B"+str(this.bc+1000,4)
            w = this.ourname
            define push &b of &w at 1000,1000 prompt "Button"
        endif
        this[this.bc].caption = ltrim(str(x))+","+ltrim(str(y))
        this[this.bc].left = x
        this[this.bc].top = y
    endif

*******************************************************************************
function MouseMove
* Event handler for window created with MakeSizeWindow()
*
* Called by Event.prg
*******************************************************************************
    parameters x, y, flags
    if this.capture
        this.Width = x
        this.Height = y
    endif
    return .f.

*******************************************************************************
procedure LeftMouseDown
*  Event handler for window created with MakeSizeWindow()
*
* Called by Event.prg
*******************************************************************************
    parameters x, y, flags
    if this.capture
        this.capture = .f.
    else
        this.capture = .t.
        x = this.OnMouseMove(x,y,flags)
    endif


*** End of Procedures and Functions called by Event.prg ***


*** Procedures and Functions called by WinApi ***

*******************************************************************************
procedure OnSelApi

* On selection routine for the Api window.  Executes the function/group of
* functions specified by the marked radiobutton.  If "Cancel" was pressed,
* the window is closed.
*
* Called by WinApi.prg
*******************************************************************************
private selection
selection = activecontrol()
if selection = "CANCEL"
   set procedure to
   close window Api
else
   if selection = "WINDIR"  && function that returns a result
      ?WinDir()
   else
      do &selection         && don't need to see the results of these
   endif
endif





********************************************************************************
function SysInfo

* Display information about the system.
*
* Called by WinApi.prg
********************************************************************************
setup()
getinfo()
showit()
leave()


********************************************************************************
FUNCTION gVer

* Gets information from the windows function
* GetVersion(), which returns the major and minor
* DOS and Windows versions as a CLONG.
*
*
* The "High Byte of the High Word" contains the
* major DOS version, the "Low Byte of the High Word"
* contains the minor DOS version. The "High Byte of
* the Low Word" specifies the minor version of
* windows and the "Low byte of the Low Word"
* specifies the major windows version. The Bit
* functions are used to extract the proper values.
* BitRshift(), BitAnd().
*
* Called by WinApi.prg
********************************************************************************
PARAM verType
#define HiWord(x) (bitrshift(bitand(x,4294901760),16))
#define LoWord(x) (bitand(x,65535))
#define HiByte(x) (ltrim(str(bitrshift(bitand(x,65280),8))))
#define LoByte(x) (ltrim(str(bitand(x,255))))
EXTERN PASCAL CLONG GetVersion( )  krnl386.exe
z=GetVersion( )
IF UPPER(verType)="DOS"
  RETURN HiByte(HiWord(z))+"."+LoByte(HiWord(z))
ENDIF
IF LEFT(UPPER(verType),3)="WIN"
  RETURN  LoByte(LoWord(z))+"."+HiByte(LoWord(z))
ENDIF


********************************************************************************
FUNCTION setup

* Called by Sysinfo().  This functions declares all the necessary
* Windows API functions used for displaying system information, and defines
* the window that will display that information.
*
* Called from file WinApi.prg
********************************************************************************
CLEAR
SET TALK OFF
Public mMode,mCpu,mCoprocess,mFreeMem,mInstance,wFreeMem,hndDBW
hndDBW=_APP.FRAMEWIN.HWND
EXTERN PASCAL CWORD GetWinFlags( )  krnl386.exe
EXTERN PASCAL CWORD GetModuleUsage(CWORD)  krnl386.exe
EXTERN PASCAL CWORD GetModuleHandle(CPTR)  krnl386.exe
EXTERN PASCAL CWORD GetVersion( )  user.exe
EXTERN PASCAL CWORD ShowWindow(CWORD,CWORD)  user.exe
DEFINE WINDOW sysinfo FROM 0,0 TO 19,40 TITLE "Windows System Information";
              OF application SIZEABLE
DEFINE PUSHBUTTON ok OF sysinfo PROMPT "    OK     " at 16,14
ON SELECTION WINDOW sysinfo DO leave
RETURN 0

********************************************************************************
FUNCTION getInfo

* Called by Sysinfo().  This function makes the necessary API calls, and assigns
* the accessed information to variables that will be displayed in the window
* showing system information.
*
* Called from file WinApi.prg
********************************************************************************
mX1=GetModuleHandle("DBASEWIN.EXE") && "SYSINFO"
mInstance=GetModuleUsage(mX1)
x=GetWinFlags()
mMode=IIF(x =BitOr(x,32),"Enhanced Mode",IIF(x=BitOr(x,16),"Standard Mode",;
    IIF(x=BitOr(x,2),"Running Win286","")))
mCpu=IIF(BitOr(x,8)=x,"80486",IIF(x=BitOr(x,4),"80386",IIF(x=BitOr(x,2),"80286",;
    IIF(x=BitOr(x,128),"80186",IIF(x=BitOr(x,64),"8086","")))))
mCoprocess=IIF(x=BitOr(x,1024),"Yes","No ")
mFreeMem=LTRIM(STR(MEMO()))+"K"
extern pascal clong GetFreeSpace( cword )  krnl386.exe
wFreeMem=ltrim(str(GetFreeSpace(0)/1024))+"K"
RETURN 0

********************************************************************************
FUNCTION showIt

* Called by Sysinfo().  This function brings up the window with system
* information retrieved by calling Windows API functions through Bladerunner.
*
* Called from file WinApi.prg
********************************************************************************
CLEAR
? ShowWindow(hndDBW,7) && 7 make icon no acitve
ACTIVATE WINDOW sysinfo
@  2,2 SAY "Number Of Instances      "+LTRIM(STR(mInstance))
@  4,2 SAY "Windows Version          "+gVer("WIN")
@  6,2 SAY "Mode of Operation        "+mMode
@  8,2 SAY "CPU Type                 "+mCpu
@  10,2 SAY "Coprocessor Present      "+mCoprocess
@ 12,2 SAY "Free Global Memory       "+wFreeMem
@ 14,2 SAY "Dos Version              "+gVer("DOS")

readmodal("sysinfo")
RETURN 0

********************************************************************************
FUNCTION leave

* Called by Sysinfo().  Releases the window displaying system information.
*
* Called from file WinApi.prg
********************************************************************************
? ShowWindow(hndDBW,4) && This works fine by it's self
ACTIVATE SCREEN

RELEASE WINDOW sysinfo
RETURN 0


*******************************************************************************
procedure SysParm

* Calls the Windows function SystemParametersInfo( ) for
* seting up the windows desktop wallpaper.
* Displays a getfile box to pick the wallpaper for
* the windows desktop.
*
*  Called by WinApi.prg
*******************************************************************************
EXTERN PASCAL CWORD SystemParametersInfo(CWORD,CWORD,CPTR,CWORD) user.exe
x=GETFILE("*.BMP","dBASE Wallpaper changer")
DO WHILE LEN(x) > 0
  SystemParametersInfo(20,0,x,2)
  x=GETFILE("*.BMP","dBASE Wallpaper changer")
ENDDO






*******************************************************************************
FUNCTION OkCanBox

* OkCanBox(<cMess>,<cTitle>).
* <cMess>  = Message to display in Box.
* <cTitle> = Title of Message Box.
*
* Creates a MessageBox on the SCREEN with
* a title and message text. The user must
* press or click OK or CANCEL or press ESCAPE
* key. This is a System Modal MessageBox.
* Calls the Windows function messagebox().
* choice = okcanbox("Read my lips","Message Box")
* 2 if Escape pressed, 1 if OK button pressed,
* 2 if CANCEL pressed. Or 0 if not enough memory.
*
*  Called by WinApi.prg
*******************************************************************************
* Returns 0 if not enough memory to create MessageBox.
* Returns 1=OK,2=CANCEL,3=ABORT,4=RETRY,5=IGNORE,6=YES,7=NO,8=ONE
*   wType any combo of below
*       MODE                         DEFAULT BUTTON
*0x3000h=12288D Mode Mask  0x0F00h=3840 Dec Def.Button
*0x0000h=00000D App Modal  0x0000h=0000 Dec Button 1
*0x1000h=04096D Sys Modal  0x0100h=0256 Dec Button 2
*0x2000h=08192D Task Modal 0x0200h=0512 Dec Button 3
*                          0x0300h=0768 Dec Button 4
*                          0x0400h=1024 Dec Button 5
*                          0x0500h=1280 Dec Button 6
*                          0x0600h=1536 Dec Button 7
*                          0x0700h=1792 Dec Button 8
*        ICON                           BUTTON
*0x00F0h=0240D Icon Mask  0x000Fh=0015Dec Type Mask
*0x0010h=0016D Hand       0x0000h=0000Dec OK Button
*0x0010h=0016D Stop *     0x0001h=0001Dec OK CANCEL
*0x0020h=0032D Question   0x0002h=0002Dec ABORT RETRY IGNORE
*0x0030h=0048D Exclaimation 0003h=0003Dec YES NO CANCEL
*0x0040h=0064D Astrisk    0x0004h=0004Dec YES NO
*0x0040h=0064D Information x0005h=0005Dec RETRY CANCEL
*                         0x0008h=0008Dec ABORT RETRY
*                         0x0009h=0009Dec OK CANCEL ABORT
*                                         RETRY IGNORE
*                         0x000Ah=0010Dec NO CANCEL RETRY
*                                         CANCEL GARBAGE
*                         0x000Bh=0011Dec OK CANCEL ABORT
*                                         RETRY IGNORE YES
*                                         NO CANCEL
*******************************************************************************
PARAMETERS cMess, cTitle
wType=HTOI("1031") && 1031h=4145decimal
cMess1=IIF(ISBLANK(cMess),"Put Message Here! "+CHR(13)+CHR(13)+;
     "Syntax is: "+CHR(13)+"? OkcanBox('Message','Title')"+;
     CHR(13) + CHR(13) + "Returns: " + CHR(13) +;
     "1 if OK button clicked or pressed"+CHR(13)+;
     "2 if Cancel button or Escape key pressed"+CHR(13)+;
     "0 if not enough memory to run",cMess)
cTitle1=IIF(ISBLANK(cTitle),"OkcanBox( ) Message Function",cTitle)
extern pascal cword messagebox(cword,cptr,cptr,cword ) user.exe
npressed=messagebox(0,cMess1,cTitle1,wType)
RETURN npressed





*******************************************************************************
procedure winwall

* Calls the Windows WallPaper changer program.
* First it reduces dBASE to an ICON then it
* changes into the windows directory and displays a
* GETFILE() box of the *.BMP files in the windows
* directory then it changes the desktop wallpaper to
* the file you choose.Next it asks if you want to keep
* the Wallpaper or set it to (None) Then it returns to
* the directory you started from and restores dBASE
* from the ICON.
*
*
*  Called by WinApi.prg
*******************************************************************************
EXTERN PASCAL CWORD SystemParametersInfo(CWORD,CWORD,CPTR,CWORD) user.exe
EXTERN PASCAL CWORD CloseWindow(CWORD) user.exe
EXTERN PASCAL CWORD OpenIcon(CWORD) user.exe
hndDBW=_APP.FRAMEWIN.HWND
CloseWindow(hndDBW)
orgDir  = SET("DIRECTORY")
winPath = winDir()
SET DIRECTORY TO &winPath
x=GETFILE("*.BMP","dBASE Wallpaper changer")
DO WHILE LEN(x) > 0
  SystemParametersInfo(20,0,x,1) && WAS 2
  x=GETFILE("*.BMP","dBASE Wallpaper changer")
ENDDO
blankWall = OkCanBox("Press OK to keep the Wallpaper"+;
        CHR(13)+"or press Cancel to set wallpaper to (None)",;
       "Keep the wallpaper or set to (None) ?")
IF blankWall = 2
   SystemParametersInfo(20,0,"(None)",2)
ENDIF
OpenIcon(hndDBW)
SET DIRECTORY TO &orgDir




*******************************************************************************
procedure GetWinTX

* Calls the Windows function GetWindowText to get title of the
* Bladerunner frame window
*
*  Called by WinApi.prg
*******************************************************************************

dBWhand = _APP.FRAMEWIN.HWND
EXTERN PASCAL CWORD GetWindowText(CWORD,CPTR,CWORD)  user.exe
winTitle = SPACE(80)      && first make empty string to be filled
lenTitle = GetWindowText(dBWhand,winTitle,80)
? "The Title of dBASEWIN window from API call"
? winTitle
?
*  Note: The Object modle allows you to get this information with
*        the following command.
? _APP.FRAMEWIN.CAPTION
? "The Title of dBASEWIN window from the Object Model"







*******************************************************************************
procedure Icon

* This example just minimizes dBASEWIN.EXE to a
* ICON (by way of the CloseWindow funtion) waits 5
* seconds then restores dBASEWIN.EXE from its ICON.
*
*  Called by WinApi.prg
*******************************************************************************
EXTERN PASCAL CWORD CloseWindow(CWORD)  user.exe
EXTERN PASCAL CWORD OpenIcon(CWORD)  user.exe
hwnd = _APP.FRAMEWIN.HWND  && gets the window handle for dBASE.
CloseWindow(hwnd)          && reduce dBASE to an ICON
INKEY(5)                   && wait 5 seconds
OpenIcon(hwnd)             && restore dBASE from an ICON



*******************************************************************************
FUNCTION  winDir

* Calls the Windows Funnction GetWindowsDirectory( ) which
* is used to get the Directory that windows is
* installed in.
*
*  Called by WinApi.prg
*******************************************************************************
EXTERN PASCAL CWORD GetWindowsDirectory(CPTR,CWORD) krnl386.exe
cWinDir = SPACE(144)
cWinDirLen = GetWindowsDirectory(cWinDir,144)
return cWinDir


*** End of Procedures and Functions called by Winapi ***


*** Procedures and Functions called by Puzzle.prg ***



*************************************************
function MakePaint
*
*  Called by Puzzle.prg
*************************************************
    parameters x, y, flags
    private p

    p = new PaintWindow()
    junk = p.Init()
    return .f.

*--BUG: Functions have to appear at the end of the file (after class definitions)
*
*************************************************
function MakePuzzle
*
*  Called by Puzzle.prg
*************************************************
    parameters x, y, flags
    private p
    p = new Puzzle()
    x = p.Show()
    return .f.

*************************************************
function MakeDraw
*
*  Called by Puzzle.prg
*************************************************
    parameters x, y, flags
    private p

    p = new DrawWindow()
    junk = p.Init()
    return .f.

*************************************************
function RGB
*  Creates appropriate color number from the
*  passed red,green,blue color values
*
*  Called by Puzzle.prg
*************************************************
    parameter r,g,b
    return b*65536+g*256+r

*************************************************
function Rect
*  Creates a rectangle
*
*  Called by Puzzle.prg
*************************************************
    parameter left, top, width, height
    return MakeInt(left)+MakeInt(top)+MakeInt(width+left)+MakeInt(top+height)

*************************************************
function MakeInt
*
*  Called by Puzzle.prg
*************************************************
    parameter int
    return chr(bitand(int,255))+chr(bitr(int,8))

*************************************************
function PushedButton
*  Toggles a color button's color being added to
*  the current painting color mixture.
*
*  Called by Puzzle.prg
*************************************************
    parameters x, y, flags
    if isupper(this.caption)
        this.caption = lower(this.caption)
        this.colorval = 0
    else
        this.caption = upper(this.caption)
        this.colorval = 255
    endif
    junk = this.owner.SetButtonColor()
    return .f.



*** End of Procedures and Functions called by Puzzle.prg ***


*** Procedures and Functions called by OpenWind.prg ***




*******************************************************************************
procedure ShowInfo

* Brings up the Info window.  This window contains text objects that correspond
* to whatever information was selected for viewing in the previous, SelectInfo
* window, and an image containing the map of Europe highlighting the currently
* selected country.  "Cancel" in this window closes it.
*
* Called by OpenWind.prg
*******************************************************************************
private cnt,countryName,background,newArea
windCnt = windCnt + 1
cnt = ltrim(str(windCnt))
countryName = rtrim(country->name)+cnt  && in case the same country is chosen
                                        && more than once
background = iif(mod(windCnt,2)=0,"b","bg")  && alternate background window color
newArea = ltrim(str(select()))
if newArea <> "0"
   use country in select() again alias &countryName
   select &countryName
   * don't let the windows go off the screen
   define window Info&cnt from 2+mod(windCnt*2,20),30 + mod(windCnt,10);
      to 13+mod(windCnt*2,20),70+mod(windCnt,10) ;
      of application;
      title "Info -- " + country->name;
      sizeable;
      color w+/&background
   * show the population field for the current country
   define text popText of Info&cnt at 2,3 prompt "Population:"
   define text popInfo of Info&cnt at 3,5 prompt country->population;
      picture "999,999,999,999" function "T" color rb/&background
   * show the capital field for the current country
   define text capText of Info&cnt at 5,3 prompt "Capital:"
   define text capInfo of Info&cnt at 6,5 prompt upper(country->capital);
      color rb/&background
   * show the map of the current country highlighted on a map of Europe
   define text mapText of Info&cnt at 1,25 prompt country->name;
      color gr+/&background
   define image map of Info&cnt from 2,20 to 12,38 memo country->map
   define pushbutton cancel of Info&cnt at 8,5 prompt "CANCEL" default
   on selection window Info&cnt close window Info&cnt

   * OPEN this window, and set focus to it.  This command causes Info to be
   * added to the list of the currently open windows, but doesn't stop program
   * control flow at the OPEN line.  This window is not modal.
   open window Info&cnt
   set focus to Info&cnt
else && no more available areas
   * Cheap warning
   ?"No more available workareas"
endif

return


*******************************************************************************
function Clean_Openwindow

* This function closes the Country database, and releases all public variables.
*
* Called by OpenWind.prg
*******************************************************************************
use in country
release windcnt
return .t.